home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / dev / lang / pcq12src.lzh / Source / Initialize.p < prev    next >
Text File  |  1991-04-12  |  9KB  |  261 lines
  1. External;
  2.  
  3. {
  4.     Initialize.p (of PCQ Pascal)
  5.     Copyright (c) 1989 Patrick Quaid.
  6.  
  7.     This routine initializes all the global variables and
  8. enters the standard identifiers.
  9. }
  10.  
  11. {$O-}
  12. {$I "Pascal.i"}
  13.  
  14.     Function AddType(at_Object : TypeObject;
  15.              at_SubType: TypePtr;
  16.              at_Ref    : Address;
  17.              at_Upper,
  18.              at_Lower,
  19.              at_Size   : Integer) : TypePtr;
  20.         external;
  21.  
  22.     Function EnterStandard(    es_Name : String;
  23.                 es_Object : IDObject;
  24.                 es_Type : TypePtr;
  25.                 es_Storage : IDStorage;
  26.                 es_Offset : Integer) : IDPtr;
  27.         external;
  28.  
  29.     Function AllocString(l : integer): string;
  30.         external;
  31.  
  32.     Procedure NewBlock;
  33.         external;
  34.     Procedure NewSpell;
  35.         external;
  36.     Procedure Abort;
  37.         External;
  38.     
  39. Procedure InitStandard;
  40.  
  41. {
  42.     This is a huge routine, but since it's so straightforward I
  43. don't think I'll split it up.  It just enters all the standard
  44. identifiers into the identifier table.  Note that 'nil' is
  45. considered a standard identifier.
  46. }
  47. var
  48.     ID : IDPtr;
  49.     TP : TypePtr;
  50. begin
  51.     BadType := AddType(ob_ordinal, nil, nil, 0, 0, 4);
  52.     BadType^.SubType := BadType;
  53.  
  54.     IntType := AddType(ob_ordinal, nil, nil, 0, 0, 4);
  55.     ID := EnterStandard("Integer", obtype, IntType, st_none, 0);
  56.  
  57.     ShortType := AddType(ob_ordinal, nil, nil, 0, 0, 2);
  58.     ID := EnterStandard("Short", obtype, ShortType, st_none, 0);
  59.  
  60.     BoolType := AddType(ob_ordinal, nil, nil, 0, 0, 1);
  61.     ID := EnterStandard("Boolean", obtype, BoolType, st_none, 0);
  62.  
  63.     CharType := AddType(ob_ordinal, nil, nil, 0, 0, 1);
  64.     ID := EnterStandard("Char", obtype, CharType, st_none, 0);
  65.  
  66.     TextType := AddType(ob_file, CharType, nil, 0, 0, 32);
  67.     ID := EnterStandard("Text", obtype, TextType, st_none, 0);
  68.  
  69.     StringType := AddType(ob_pointer, CharType, IntType, 0, 0, 4);
  70.     ID := EnterStandard("String", obtype, StringType, st_none, 0);
  71.  
  72.     RealType := AddType(ob_real, nil, nil, 0, 0, 4);
  73.     ID := EnterStandard("Real", obtype, RealType, st_none, 0);
  74.  
  75.     ByteType := AddType(ob_ordinal, nil, nil, 0, 0, 1);
  76.     ID := EnterStandard("Byte", obtype, ByteType, st_none, 0);
  77.  
  78.     AddressType := AddType(ob_pointer, BadType, Nil, 0, 0, 4);
  79.     ID := EnterStandard("Address", obtype, AddressType, st_none, 0);
  80.  
  81.     LiteralType := AddType(ob_array, CharType, IntType, 1, 1, 1);
  82.  
  83.     ID := EnterStandard("Write", stanproc, nil, st_none, 1);
  84.     ID := EnterStandard("WriteLn", stanproc, nil, st_none, 2);
  85.     ID := EnterStandard("Read", stanproc, nil, st_none, 3);
  86.     ID := EnterStandard("ReadLn", stanproc, nil, st_none, 4);
  87.     ID := EnterStandard("New", stanproc, nil, st_none, 5);
  88.     ID := EnterStandard("Dispose", stanproc, nil, st_none, 6);
  89.     ID := EnterStandard("Close", stanproc, nil, st_none, 7);
  90.     ID := EnterStandard("Get", stanproc, nil, st_none, 8);
  91.     ID := EnterStandard("Exit", stanproc, nil, st_none, 9);
  92.     ID := EnterStandard("Trap", stanproc, nil, st_none, 10);
  93.     ID := EnterStandard("Put", stanproc, nil, st_none, 11);
  94.     ID := EnterStandard("Inc", stanproc, nil, st_none, 12);
  95.     ID := EnterStandard("Dec", stanproc, nil, st_none, 13);
  96.     ID := EnterStandard("Reset", stanproc, Nil, st_none, 14);
  97.     ID := EnterStandard("Rewrite", stanproc, Nil, st_none, 15);
  98.  
  99.     ID := EnterStandard("Ord", stanfunc, IntType, st_none, 1);
  100.     ID := EnterStandard("Chr", stanfunc, CharType, st_none, 2);
  101.     ID := EnterStandard("Odd", stanfunc, BoolType, st_none, 3);
  102.     ID := EnterStandard("Abs", stanfunc, IntType, st_none, 4);
  103.     ID := EnterStandard("Succ", stanfunc, IntType, st_none, 5);
  104.     ID := EnterStandard("Pred", stanfunc, IntType, st_none, 6);
  105.     ID := EnterStandard("Reopen", stanfunc, BoolType, st_none, 7);
  106.     ID := EnterStandard("Open", stanfunc, BoolType, st_none, 8);
  107.     ID := EnterStandard("EOF", stanfunc, BoolType, st_none, 9);
  108.     ID := EnterStandard("Trunc", stanfunc, IntType, st_none, 10);
  109.     ID := EnterStandard("Round", stanfunc, IntType, st_none, 11);
  110.     ID := EnterStandard("Float", stanfunc, RealType, st_none, 12);
  111.     ID := EnterStandard("Floor", stanfunc, RealType, st_none, 13);
  112.     ID := EnterStandard("Ceil", stanfunc, RealType, st_none, 14);
  113.     ID := EnterStandard("SizeOf", stanfunc, IntType, st_none, 15);
  114.     ID := EnterStandard("Adr", stanfunc, AddressType, st_none, 16);
  115.     ID := EnterStandard("Bit", stanfunc, IntType, st_none, 17);
  116.     ID := EnterStandard("Sqr", stanfunc, RealType, st_none, 18);
  117.     ID := EnterStandard("Sin", stanfunc, RealType, st_none, 19);
  118.     ID := EnterStandard("Cos", stanfunc, RealType, st_none, 20);
  119.     ID := EnterStandard("Sqrt", stanfunc, RealType, st_none, 21);
  120.     ID := EnterStandard("Tan", stanfunc, RealType, st_none, 22);
  121.     ID := EnterStandard("ArcTan", stanfunc, RealType, st_none, 23);
  122.     ID := EnterStandard("Ln", stanfunc, RealType, st_none, 24);
  123.     ID := EnterStandard("Exp", stanfunc, RealType, st_none, 25);
  124.  
  125.     ID := enterstandard("True", constant, BoolType, st_none, -1);
  126.     ID := enterstandard("False", constant, BoolType, st_none, 0);
  127.     ID := enterstandard("MaxInt", constant, IntType, st_none, $7FFFFFFF);
  128.     ID := enterstandard("MaxShort", constant, ShortType, st_none, $7FFF);
  129.     ID := enterstandard("Nil", constant, AddressType, st_none, 0);
  130.  
  131.     ID := EnterStandard("CommandLine", global, StringType, st_external, 0);
  132.     ID := EnterStandard("ExitProc", global, AddressType, st_external, 0);
  133.     ID := EnterStandard("ExitCode", global, IntType, st_external, 0);
  134.     ID := EnterStandard("ExitAddr", global, AddressType, st_external, 0);
  135.     ID := EnterStandard("IOResult", func, IntType, st_external, 0);
  136.     ID := EnterStandard("Input", global, TextType, st_external, 0);
  137.     ID := EnterStandard("Output", global, TextType, st_external, 0);
  138.     ID := EnterStandard("HeapError", global, AddressType, st_external, 0);
  139. end;
  140.  
  141.  
  142. Procedure InitReserved();
  143.  
  144. {
  145.     This initializes the array of reserved words.  If you mess
  146. around with this, be advised that the symbol numbers defined in
  147. pasconst.i correspond with the indices of these words.  Look at
  148. searchreserved in utilities.p to explain the previous sentence.
  149. }
  150.  
  151. begin
  152.     Reserved[And1]    := "AND";
  153.     Reserved[Array1]    := "ARRAY";
  154.     Reserved[Begin1]    := "BEGIN";
  155.     Reserved[By1]    := "BY";
  156.     Reserved[Case1]    := "CASE";
  157.     Reserved[Const1]    := "CONST";
  158.     Reserved[Div1]    := "DIV";
  159.     Reserved[Do1]    := "DO";
  160.     Reserved[Downto1]    := "DOWNTO";
  161.     Reserved[Else1]    := "ELSE";
  162.     Reserved[End1]    := "END";
  163.     Reserved[Extern1]    := "EXTERNAL";
  164.     Reserved[File1]    := "FILE";
  165.     Reserved[For1]    := "FOR";
  166.     Reserved[Forward1]    := "FORWARD";
  167.     Reserved[Func1]    := "FUNCTION";
  168.     Reserved[Goto1]    := "GOTO";
  169.     Reserved[If1]    := "IF";
  170.     Reserved[In1]    := "IN";
  171.     Reserved[Label1]    := "LABEL";
  172.     Reserved[Mod1]    := "MOD";
  173.     Reserved[Not1]    := "NOT";
  174.     Reserved[Of1]    := "OF";
  175.     Reserved[Or1]    := "OR";
  176.     Reserved[Packed1]    := "PACKED";
  177.     Reserved[Private1]    := "PRIVATE";
  178.     Reserved[Proc1]    := "PROCEDURE";
  179.     Reserved[Program1]    := "PROGRAM";
  180.     Reserved[Record1]    := "RECORD";
  181.     Reserved[Repeat1]    := "REPEAT";
  182.     Reserved[Return1]    := "RETURN";
  183.     Reserved[Set1]    := "SET";
  184.     Reserved[Shl1]    := "SHL";
  185.     Reserved[Shr1]    := "SHR";
  186.     Reserved[Then1]    := "THEN";
  187.     Reserved[To1]    := "TO";
  188.     Reserved[Type1]    := "TYPE";
  189.     Reserved[Until1]    := "UNTIL";
  190.     Reserved[Var1]    := "VAR";
  191.     Reserved[While1]    := "WHILE";
  192.     Reserved[With1]    := "WITH";
  193.     Reserved[Xor1]    := "XOR";
  194. end;
  195.  
  196. Function IsInteractive(handle : Address) : Boolean;
  197.     External;
  198.  
  199. Procedure CheckStdIn;
  200. var
  201.     FileRec : ^Address;
  202. begin
  203.     FileRec := Adr(Output);
  204.     StdOut_Interactive := IsInteractive(FileRec^);
  205. end;
  206.  
  207. Function HeapFunc(Size : Integer) : Integer;
  208. begin
  209.     Writeln('\nERROR: Out of Memory\n');
  210.     Abort;
  211.     HeapFunc := 0;
  212. end;
  213.     
  214. Procedure InitGlobals;
  215.  
  216. {
  217.     This just puts the startup values into the variables.
  218. }
  219.  
  220. begin
  221.     litlab := 1;
  222.  
  223.     symtext := allocstring(80);
  224.  
  225.     Code_Table := Address(AllocString(MaxCode * 4));
  226.     NextCode := 0;
  227.  
  228.     eqstart := 0;
  229.     eqend := 0;
  230.     errorptr := 0;
  231.  
  232.     NextFreeExprNode := 0;
  233.  
  234.     LitPtr := 0;
  235.     SpellPtr := 0;
  236.     NewSpell;
  237.     errorcount := 0;
  238.     lineno := 1;
  239.     FirstWith := Nil;
  240.     StackLoad := 0;
  241.     currsym := Unknown1;
  242.     symloc := 0;
  243.     currfn := Nil;
  244.     TypeID := Nil;
  245.     nxtlab := 1;
  246.     CharBuffed := False;
  247.     RangeCheck := false;
  248.     ConstantExpression := False;
  249.     MathLoaded := False;
  250.     IOCheck := True;
  251.     ShortCircuit := True;
  252.     SmallInitialize := False;
  253.     Inform := True;
  254.     CheckStdIn;
  255.     IncludeList := Nil;
  256.     CurrentBlock := Nil;
  257.     NewBlock;
  258.  
  259. {    HeapError := Adr(HeapFunc); }
  260. end;
  261.